&ANALYZE-SUSPEND _VERSION-NUMBER AB_v10r12 GUI adm2
&ANALYZE-RESUME
&Scoped-define WINDOW-NAME CURRENT-WINDOW


/* Temp-Table and Buffer definitions                                    */
DEFINE TEMP-TABLE ab_unmap
       FIELD abocad AS LOGICAL  INITIAL no
       FIELD alang AS CHARACTER FORMAT "X(256)":U 
       FIELD cadeauset AS CHARACTER FORMAT "X(256)":U 
       FIELD entete AS CHARACTER FORMAT "X(256)":U 
       FIELD erreur AS CHARACTER FORMAT "X(256)":U 
       FIELD FRowid AS CHARACTER FORMAT "X(256)":U 
       FIELD ident AS CHARACTER FORMAT "X(256)":U 
       FIELD labcadeau AS CHARACTER FORMAT "X(256)":U 
       FIELD ligne AS CHARACTER FORMAT "X(256)":U 
       FIELD LRowid AS CHARACTER FORMAT "X(256)":U 
       FIELD navigation AS CHARACTER FORMAT "X(256)":U 
       FIELD nbart AS CHARACTER FORMAT "X(256)":U 
       FIELD prog_suivant AS CHARACTER FORMAT "X(256)":U 
       FIELD texte1 AS CHARACTER FORMAT "X(256)":U 
       FIELD texte2 AS CHARACTER FORMAT "X(256)":U 
       FIELD texte3 AS CHARACTER FORMAT "X(256)":U 
       FIELD TypeInt AS CHARACTER FORMAT "X(256)":U .



&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _DEFINITIONS w-html 
/*------------------------------------------------------------------------

  File: 

  Description: 

  Input Parameters:
      <none>

  Output Parameters:
      <none>

  Author: 

  Created: 

------------------------------------------------------------------------*/
/*           This .W file was created with AppBuilder.                  */
/*----------------------------------------------------------------------*/

/* Create an unnamed pool to store all the widgets created 
     by this procedure. This is a good default which assures
     that this procedure's triggers and internal procedures 
     will execute in this procedure's storage, and that proper
     cleanup will occur on deletion of the procedure. */
CREATE WIDGET-POOL.

/* ***************************  Definitions  ************************** */

/* Preprocessor Definitions ---                                         */

/* Parameters Definitions ---                                           */

/* Local Variable Definitions ---                                       */

DEF TEMP-TABLE TT-abo   NO-UNDO
    FIELD nohist AS INTEGER
    FIELD libel  AS CHARACTER
    FIELD noadrb AS INTEGER
    FIELD csmtb  AS INTEGER
    FIELD nb     AS INTEGER
    FIELD recu   AS CHARACTER
    FIELD ech    AS CHARACTER
    FIELD id     AS CHARACTER
    FIELD idr    AS RECID
    INDEX key1 noadrb csmtb nohist
    INDEX key2 id.


DEF VAR wcoul-colp      AS CHARACTER                 NO-UNDO.
DEF VAR wcoul-coli      AS CHARACTER                 NO-UNDO.

DEF VAR tab-lib         AS CHARACTER EXTENT 10       NO-UNDO.
DEF VAR lib-rec         AS CHARACTER                 NO-UNDO.
DEF VAR lib-type        AS CHARACTER                 NO-UNDO.
DEF VAR lib-lang        AS CHARACTER                 NO-UNDO.
DEF VAR lib-stat        AS CHARACTER                 NO-UNDO.

DEF VAR i               AS INTEGER                   NO-UNDO.
DEF VAR j               AS INTEGER                   NO-UNDO.
DEF VAR nb-record       AS INTEGER                   NO-UNDO.


DEF VAR f-labind        AS CHARACTER                 NO-UNDO.
DEF VAR f-labindf       AS CHARACTER                 NO-UNDO.
DEF VAR f-labinda       AS CHARACTER                 NO-UNDO.

DEF VAR f-labtous       AS CHARACTER                 NO-UNDO.
DEF VAR f-labtousf      AS CHARACTER                 NO-UNDO.
DEF VAR f-labtousa      AS CHARACTER                 NO-UNDO.
DEF VAR f-labtcah       AS CHARACTER                 NO-UNDO.
DEF VAR f-labtcahf      AS CHARACTER                 NO-UNDO.
DEF VAR f-labtcaha      AS CHARACTER                 NO-UNDO.
DEF VAR f-labtmar       AS CHARACTER                 NO-UNDO.
DEF VAR f-labtmarf      AS CHARACTER                 NO-UNDO.
DEF VAR f-labtmara      AS CHARACTER                 NO-UNDO.
DEF VAR f-labtact       AS CHARACTER                 NO-UNDO.
DEF VAR f-labtactf      AS CHARACTER                 NO-UNDO.
DEF VAR f-labtacta      AS CHARACTER                 NO-UNDO.
DEF VAR action          AS CHARACTER                 NO-UNDO.

DEF VAR flag-aff        AS LOGICAL                   NO-UNDO.
DEF VAR flag-libraire   AS LOGICAL                   NO-UNDO.
DEF VAR flag-tous       AS LOGICAL                   NO-UNDO.
DEF VAR lst-hors        AS CHARACTER                 NO-UNDO.

DEF VAR lab-rec         AS CHARACTER  INIT "Lib rec" NO-UNDO.
DEF VAR a-lang          AS INTEGER                   NO-UNDO.
DEF VAR lab-bouton      AS CHARACTER EXTENT 5        NO-UNDO.

DEF VAR flag-int        AS LOGICAL                   NO-UNDO.
DEF VAR flag-ou         AS LOGICAL                   NO-UNDO.
DEF VAR flag-select     AS LOGICAL                   NO-UNDO.
DEF VAR flag-delete     AS LOGICAL                   NO-UNDO.

DEF VAR buf-psuivant    AS CHARACTER                 NO-UNDO.

DEF VAR buf-nocad       AS INTEGER                   NO-UNDO.
DEF VAR buf-nocli       AS INTEGER                   NO-UNDO.
DEF VAR buf-csmt        AS INTEGER                   NO-UNDO.

DEF VAR buf-nbart       AS INTEGER                   NO-UNDO.
DEF VAR buf-nosoc       AS INTEGER  INIT 1           NO-UNDO.

DEF VAR buf-mont        AS DECIMAL                   NO-UNDO.
DEF VAR lst-mon         AS CHARACTER                 NO-UNDO.
DEF VAR buf-mon         AS CHARACTER INIT "EUR"      NO-UNDO.

DEF NEW SHARED VAR buf-codmon           LIKE apri.codmon                     NO-UNDO.
DEF NEW SHARED VAR buf-datdoc           LIKE atar.datfin                     NO-UNDO.
DEF NEW SHARED VAR buf-typr             LIKE atar.typr                       NO-UNDO.
DEF NEW SHARED VAR buf-tiersl           LIKE atar.tiers                      NO-UNDO.
DEF NEW SHARED VAR buf-tiersf           LIKE atar.tiers                      NO-UNDO.
DEF NEW SHARED VAR buf-noadrl           LIKE atar.noadr                      NO-UNDO.
DEF NEW SHARED VAR buf-csmtl            LIKE atar.csmt                       NO-UNDO.
DEF NEW SHARED VAR buf-noadrf           LIKE atar.noadr                      NO-UNDO.
DEF NEW SHARED VAR buf-csmtf            LIKE atar.csmt                       NO-UNDO.
DEF NEW SHARED VAR buf-type             LIKE atar.type                       NO-UNDO.
DEF NEW SHARED VAR buf-umb              LIKE arti.unit                       NO-UNDO.
DEF NEW SHARED VAR buf-umq              LIKE arti.unit                       NO-UNDO.
DEF NEW SHARED VAR buf-pcent            LIKE atar.pcent                      NO-UNDO.
DEF NEW SHARED VAR buf-pumb             AS   DECIMAL                         NO-UNDO.
DEF NEW SHARED VAR buf-pump             LIKE apri.prix                       NO-UNDO.
DEF NEW SHARED VAR buf-ump              LIKE apri.unit                       NO-UNDO.
DEF NEW SHARED VAR buf-nocpt            LIKE apri.nocpt                      NO-UNDO.
DEF NEW SHARED VAR buf-taxe             LIKE apri.taxe                       NO-UNDO.
DEF NEW SHARED VAR buf-qumb             LIKE atar.qte                        NO-UNDO.
DEF NEW SHARED VAR buf-qumq             LIKE atar.qte                        NO-UNDO.
DEF NEW SHARED VAR buf-rabchf           LIKE atar.rabaischf                  NO-UNDO.

DEF VAR abo-cour    AS     CHARACTER      NO-UNDO.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME


&ANALYZE-SUSPEND _UIB-PREPROCESSOR-BLOCK 

/* ********************  Preprocessor Definitions  ******************** */

&Scoped-define PROCEDURE-TYPE Web-Object
&Scoped-define DB-AWARE no

&Scoped-define WEB-FILE abo_new.htm

/* Name of designated FRAME-NAME and/or first browse and/or first query */
&Scoped-define FRAME-NAME Web-Frame

/* Standard List Definitions                                            */
&Scoped-Define ENABLED-OBJECTS ab_unmap.cadeauset ab_unmap.abocad ~
ab_unmap.labcadeau ab_unmap.prog_suivant ab_unmap.erreur ab_unmap.nbart ~
ab_unmap.texte1 ab_unmap.texte2 ab_unmap.texte3 ab_unmap.ident ~
ab_unmap.alang ab_unmap.entete ab_unmap.ligne ab_unmap.TypeInt ~
ab_unmap.FRowid ab_unmap.LRowid ab_unmap.navigation 
&Scoped-Define DISPLAYED-OBJECTS ab_unmap.cadeauset ab_unmap.abocad ~
ab_unmap.labcadeau ab_unmap.prog_suivant ab_unmap.erreur ab_unmap.nbart ~
ab_unmap.texte1 ab_unmap.texte2 ab_unmap.texte3 ab_unmap.ident ~
ab_unmap.alang ab_unmap.entete ab_unmap.ligne ab_unmap.TypeInt ~
ab_unmap.FRowid ab_unmap.LRowid ab_unmap.navigation 

/* Custom List Definitions                                              */
/* List-1,List-2,List-3,List-4,List-5,List-6                            */

/* _UIB-PREPROCESSOR-BLOCK-END */
&ANALYZE-RESUME



/* ***********************  Control Definitions  ********************** */


/* Definitions of the field level widgets                               */

/* ************************  Frame Definitions  *********************** */

DEFINE FRAME Web-Frame
     ab_unmap.cadeauset AT ROW 1 COL 1 HELP
          "" NO-LABEL FORMAT "X(256)":U
          VIEW-AS FILL-IN 
          SIZE 20 BY 1
     ab_unmap.abocad AT ROW 1 COL 1 HELP
          ""
          LABEL "abocad"
          VIEW-AS TOGGLE-BOX
          SIZE 20 BY 1
     ab_unmap.labcadeau AT ROW 1 COL 1 HELP
          "" NO-LABEL FORMAT "X(256)":U
          VIEW-AS FILL-IN 
          SIZE 20 BY 1
     ab_unmap.prog_suivant AT ROW 1 COL 1 HELP
          "" NO-LABEL FORMAT "X(256)":U
          VIEW-AS FILL-IN 
          SIZE 20 BY 1
     ab_unmap.erreur AT ROW 1 COL 1 HELP
          "" NO-LABEL FORMAT "X(256)":U
          VIEW-AS FILL-IN 
          SIZE 20 BY 1
     ab_unmap.nbart AT ROW 1 COL 1 HELP
          "" NO-LABEL FORMAT "X(256)":U
          VIEW-AS FILL-IN 
          SIZE 20 BY 1
     ab_unmap.texte1 AT ROW 1 COL 1 HELP
          "" NO-LABEL FORMAT "X(256)":U
          VIEW-AS FILL-IN 
          SIZE 20 BY 1
     ab_unmap.texte2 AT ROW 1 COL 1 HELP
          "" NO-LABEL FORMAT "X(256)":U
          VIEW-AS FILL-IN 
          SIZE 20 BY 1
     ab_unmap.texte3 AT ROW 1 COL 1 HELP
          "" NO-LABEL FORMAT "X(256)":U
          VIEW-AS FILL-IN 
          SIZE 20 BY 1
     ab_unmap.ident AT ROW 1 COL 1 HELP
          "" NO-LABEL FORMAT "X(256)":U
          VIEW-AS FILL-IN 
          SIZE 20 BY 1
     ab_unmap.alang AT ROW 1 COL 1 HELP
          "" NO-LABEL FORMAT "X(256)":U
          VIEW-AS FILL-IN 
          SIZE 20 BY 1
     ab_unmap.entete AT ROW 1 COL 1 HELP
          "" NO-LABEL FORMAT "X(256)":U
          VIEW-AS FILL-IN 
          SIZE 20 BY 1
     ab_unmap.ligne AT ROW 1 COL 1 HELP
          "" NO-LABEL FORMAT "X(256)":U
          VIEW-AS FILL-IN 
          SIZE 20 BY 1
     ab_unmap.TypeInt AT ROW 1 COL 1 HELP
          "" NO-LABEL FORMAT "X(256)":U
          VIEW-AS FILL-IN 
          SIZE 20 BY 1
     ab_unmap.FRowid AT ROW 1 COL 1 HELP
          "" NO-LABEL FORMAT "X(256)":U
          VIEW-AS FILL-IN 
          SIZE 20 BY 1
     ab_unmap.LRowid AT ROW 1 COL 1 HELP
          "" NO-LABEL FORMAT "X(256)":U
          VIEW-AS FILL-IN 
          SIZE 20 BY 1
     ab_unmap.navigation AT ROW 1 COL 1 HELP
          "" NO-LABEL FORMAT "X(256)":U
          VIEW-AS FILL-IN 
          SIZE 20 BY 1
    WITH 1 DOWN KEEP-TAB-ORDER OVERLAY 
         SIDE-LABELS 
         AT COL 1 ROW 1
         SIZE 60.38 BY 14.13.


/* *********************** Procedure Settings ************************ */

&ANALYZE-SUSPEND _PROCEDURE-SETTINGS
/* Settings for THIS-PROCEDURE
   Type: Web-Object
   Allow: Query
   Frames: 1
   Add Fields to: Neither
   Editing: Special-Events-Only
   Events: web.output,web.input
   Other Settings: COMPILE
   Temp-Tables and Buffers:
      TABLE: ab_unmap W "?" ?  
      ADDITIONAL-FIELDS:
          FIELD abocad AS LOGICAL  INITIAL no
          FIELD alang AS CHARACTER FORMAT "X(256)":U 
          FIELD cadeauset AS CHARACTER FORMAT "X(256)":U 
          FIELD entete AS CHARACTER FORMAT "X(256)":U 
          FIELD erreur AS CHARACTER FORMAT "X(256)":U 
          FIELD FRowid AS CHARACTER FORMAT "X(256)":U 
          FIELD ident AS CHARACTER FORMAT "X(256)":U 
          FIELD labcadeau AS CHARACTER FORMAT "X(256)":U 
          FIELD ligne AS CHARACTER FORMAT "X(256)":U 
          FIELD LRowid AS CHARACTER FORMAT "X(256)":U 
          FIELD navigation AS CHARACTER FORMAT "X(256)":U 
          FIELD nbart AS CHARACTER FORMAT "X(256)":U 
          FIELD prog_suivant AS CHARACTER FORMAT "X(256)":U 
          FIELD texte1 AS CHARACTER FORMAT "X(256)":U 
          FIELD texte2 AS CHARACTER FORMAT "X(256)":U 
          FIELD texte3 AS CHARACTER FORMAT "X(256)":U 
          FIELD TypeInt AS CHARACTER FORMAT "X(256)":U 
      END-FIELDS.
   END-TABLES.
 */
&ANALYZE-RESUME _END-PROCEDURE-SETTINGS

/* *************************  Create Window  ************************** */

&ANALYZE-SUSPEND _CREATE-WINDOW
/* DESIGN Window definition (used by the UIB) 
  CREATE WINDOW w-html ASSIGN
         HEIGHT             = 14.13
         WIDTH              = 60.38.
/* END WINDOW DEFINITION */
                                                                        */
&ANALYZE-RESUME

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _INCLUDED-LIB w-html 
/* *********************** Included-Libraries ************************* */

{src/web2/html-map.i}

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME




/* ***********  Runtime Attributes and AppBuilder Settings  *********** */

&ANALYZE-SUSPEND _RUN-TIME-ATTRIBUTES
/* SETTINGS FOR WINDOW w-html
  VISIBLE,,RUN-PERSISTENT                                               */
/* SETTINGS FOR FRAME Web-Frame
   FRAME-NAME UNDERLINE                                                 */
/* SETTINGS FOR TOGGLE-BOX ab_unmap.abocad IN FRAME Web-Frame
   EXP-LABEL EXP-FORMAT EXP-HELP                                        */
/* SETTINGS FOR FILL-IN ab_unmap.alang IN FRAME Web-Frame
   ALIGN-L EXP-LABEL EXP-FORMAT EXP-HELP                                */
/* SETTINGS FOR FILL-IN ab_unmap.cadeauset IN FRAME Web-Frame
   ALIGN-L EXP-LABEL EXP-FORMAT EXP-HELP                                */
/* SETTINGS FOR FILL-IN ab_unmap.entete IN FRAME Web-Frame
   ALIGN-L EXP-LABEL EXP-FORMAT EXP-HELP                                */
/* SETTINGS FOR FILL-IN ab_unmap.erreur IN FRAME Web-Frame
   ALIGN-L EXP-LABEL EXP-FORMAT EXP-HELP                                */
/* SETTINGS FOR FILL-IN ab_unmap.FRowid IN FRAME Web-Frame
   ALIGN-L EXP-LABEL EXP-FORMAT EXP-HELP                                */
/* SETTINGS FOR FILL-IN ab_unmap.ident IN FRAME Web-Frame
   ALIGN-L EXP-LABEL EXP-FORMAT EXP-HELP                                */
/* SETTINGS FOR FILL-IN ab_unmap.labcadeau IN FRAME Web-Frame
   ALIGN-L EXP-LABEL EXP-FORMAT EXP-HELP                                */
/* SETTINGS FOR FILL-IN ab_unmap.ligne IN FRAME Web-Frame
   ALIGN-L EXP-LABEL EXP-FORMAT EXP-HELP                                */
/* SETTINGS FOR FILL-IN ab_unmap.LRowid IN FRAME Web-Frame
   ALIGN-L EXP-LABEL EXP-FORMAT EXP-HELP                                */
/* SETTINGS FOR FILL-IN ab_unmap.navigation IN FRAME Web-Frame
   ALIGN-L EXP-LABEL EXP-FORMAT EXP-HELP                                */
/* SETTINGS FOR FILL-IN ab_unmap.nbart IN FRAME Web-Frame
   ALIGN-L EXP-LABEL EXP-FORMAT EXP-HELP                                */
/* SETTINGS FOR FILL-IN ab_unmap.prog_suivant IN FRAME Web-Frame
   ALIGN-L EXP-LABEL EXP-FORMAT EXP-HELP                                */
/* SETTINGS FOR FILL-IN ab_unmap.texte1 IN FRAME Web-Frame
   ALIGN-L EXP-LABEL EXP-FORMAT EXP-HELP                                */
/* SETTINGS FOR FILL-IN ab_unmap.texte2 IN FRAME Web-Frame
   ALIGN-L EXP-LABEL EXP-FORMAT EXP-HELP                                */
/* SETTINGS FOR FILL-IN ab_unmap.texte3 IN FRAME Web-Frame
   ALIGN-L EXP-LABEL EXP-FORMAT EXP-HELP                                */
/* SETTINGS FOR FILL-IN ab_unmap.TypeInt IN FRAME Web-Frame
   ALIGN-L EXP-LABEL EXP-FORMAT EXP-HELP                                */
/* _RUN-TIME-ATTRIBUTES-END */
&ANALYZE-RESUME

 



/* ************************  Control Triggers  ************************ */

&Scoped-define SELF-NAME ab_unmap.entete
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL ab_unmap.entete w-html WEB.output
PROCEDURE ab_unmap.entete.output .
/*------------------------------------------------------------------------------
  Purpose:     Output the value of the field to the WEB stream
               in place of the HTML field definition.
  Parameters:  p-field-defn
  Notes:       
------------------------------------------------------------------------------*/
  DEFINE INPUT PARAMETER p-field-defn AS CHARACTER NO-UNDO.
  
  DEF VAR nom_page        AS CHARACTER      NO-UNDO.
  DEF VAR ligne           AS CHARACTER      NO-UNDO.
  DEF VAR tmp-txt         AS CHARACTER      NO-UNDO.
  DEF VAR lst-tag         AS CHARACTER      NO-UNDO.
  DEF VAR pos             AS INTEGER        NO-UNDO.
  DEF VAR k               AS INTEGER        NO-UNDO.

  DO WITH FRAME {&FRAME-NAME}:
     
     FIND erreur WHERE erreur.noerr = 101155
                    AND erreur.lang  = a-lang NO-LOCK NO-ERROR.
     REPEAT i = 1 TO 3:
        tmp-txt = tmp-txt + ENTRY(i,erreur.libel,"#") + "#".
     END.
      
     j = NUM-ENTRIES(lst-mon).

     REPEAT k = 1 TO NUM-ENTRIES(lst-mon):
         tmp-txt = tmp-txt + ENTRY(k + 3,erreur.libel,"#") + "#".
         IF j = 1 THEN tmp-txt = REPLACE(tmp-txt,"&1",lst-mon).
         ELSE tmp-txt = REPLACE(tmp-txt,"&" + STRING(k),ENTRY(k,lst-mon) + "<input type=~"radio~" name=~"monnaie~" id=~"m" 
                                            + ENTRY(k,lst-mon) + "~" value=~"" + ENTRY(k,lst-mon) + "~">").
     END.

     nom_page = SEARCH("abo_new_entete.htm").
     IF nom_page = ? THEN RETURN.
     INPUT FROM VALUE(nom_page).
     REPEAT:
        IMPORT UNFORMATTED ligne.
        pos = INDEX(ligne,"<!--WSTAG").
        IF TRIM(ligne) BEGINS "<!--" AND pos = 0 THEN NEXT.
        IF pos = 0 THEN {&out} ligne SKIP.
        ELSE DO:
           RUN decode_tag(ligne,"label",OUTPUT lst-tag).
           DO i = 1 TO NUM-ENTRIES(lst-tag).
              RUN remplace_tag ("label",6,ENTRY(i,lst-tag),tmp-txt,INPUT-OUTPUT ligne).
           END.
           {&out} ligne SKIP.
        END.
     END.
  END.
  
END PROCEDURE.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME


&Scoped-define SELF-NAME ab_unmap.erreur
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL ab_unmap.erreur w-html WEB.output
PROCEDURE ab_unmap.erreur.output .
/*------------------------------------------------------------------------------
  Purpose:     Output the value of the field to the WEB stream
               in place of the HTML field definition.
  Parameters:  p-field-defn
  Notes:       
------------------------------------------------------------------------------*/
  DEFINE INPUT PARAMETER p-field-defn AS CHARACTER NO-UNDO.
  
  DO WITH FRAME {&FRAME-NAME}:
     IF REQUEST_METHOD = "POST":U AND NOT flag-select AND get-field("cadeauset") = "" THEN DO:
        RUN affiche_texte(101151,"abo_select_erreur.htm").
     END.
  END.
  
END PROCEDURE.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME


&Scoped-define SELF-NAME ab_unmap.ident
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL ab_unmap.ident w-html WEB.output
PROCEDURE ab_unmap.ident.output .
/*------------------------------------------------------------------------------
  Purpose:     Output the value of the field to the WEB stream
               in place of the HTML field definition.
  Parameters:  p-field-defn
  Notes:       
------------------------------------------------------------------------------*/
  DEFINE INPUT PARAMETER p-field-defn AS CHARACTER NO-UNDO.
  
  DO WITH FRAME {&FRAME-NAME}:
     IF buf-nocli <> 0    AND  buf-nocli <> 1001 AND
        buf-nocli <> 1001 THEN DO:
        FIND erreur WHERE erreur.noerr = 101056
                       AND erreur.lang  = a-lang NO-LOCK NO-ERROR.
        {&out} erreur.libel  " : " buf-nocli " / ".

        FIND adra WHERE adra.nosoc = 1
                    AND adra.noadr = buf-nocli
                    AND adra.csmt  = 0 NO-LOCK NO-ERROR.
        IF AVAILABLE adra THEN {&out} adra.nom.
     END.
  END.
  
END PROCEDURE.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME


&Scoped-define SELF-NAME ab_unmap.labcadeau
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL ab_unmap.labcadeau w-html WEB.output
PROCEDURE ab_unmap.labcadeau.output .
/*------------------------------------------------------------------------------
  Purpose:     Output the value of the field to the WEB stream
               in place of the HTML field definition.
  Parameters:  p-field-defn
  Notes:       
------------------------------------------------------------------------------*/
  DEFINE INPUT PARAMETER p-field-defn AS CHARACTER NO-UNDO.
  
  DO WITH FRAME {&FRAME-NAME}:
     RUN aff_label(101169).
     IF get-cookie("Livraison") <> "" AND NOT flag-delete THEN DO:
        {&out} "&nbsp;&nbsp;<input type=~"button~" value=~"".
        RUN aff_label(101170).
        {&out} "~" Onclick=~"javascript:abonnement_cadeau();~"".
     END.
  END.
  
END PROCEDURE.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME


&Scoped-define SELF-NAME ab_unmap.ligne
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL ab_unmap.ligne w-html WEB.output
PROCEDURE ab_unmap.ligne.output .
/*------------------------------------------------------------------------------
  Purpose:     Output the value of the field to the WEB stream
               in place of the HTML field definition.
  Parameters:  p-field-defn
  Notes:       
------------------------------------------------------------------------------*/
  DEFINE INPUT PARAMETER p-field-defn AS CHARACTER NO-UNDO.
  
  DEF VAR nom_page        AS CHARACTER            NO-UNDO.
  DEF VAR ligne           AS CHARACTER            NO-UNDO.
  DEF VAR lst-tag         AS CHARACTER            NO-UNDO.
  DEF VAR lst-valeur      AS CHARACTER            NO-UNDO.
  DEF VAR pos             AS INTEGER              NO-UNDO.
  DEF VAR i               AS INTEGER              NO-UNDO.
  DEF VAR num             AS INTEGER              NO-UNDO.

  DO WITH FRAME {&FRAME-NAME}:

     FOR EACH TT-abo:

         IF TT-abo.noadrb <> 0 THEN DO:
            FIND adra WHERE adra.nosoc = 1 
                        AND adra.noadr = TT-abo.noadrb
                        AND adra.csmt  = TT-abo.csmtb NO-LOCK NO-ERROR.
            lst-valeur = TT-abo.libel + "<br>" + IF AVAILABLE adra THEN adra.nom ELSE "&nbsp;".
         END.
         ELSE lst-valeur = TT-abo.libel.
         
         lst-valeur = lst-valeur + "#" + "<input type=~"text~" name=~"nb~" size=~"2~" value=~"".

         IF NUM-ENTRIES(get-cookie("abonnement"),"#") >= 3 THEN 
            lst-valeur = lst-valeur + ENTRY(3,get-cookie("abonnement"),"#") + "~">" + "#".
         ELSE lst-valeur = lst-valeur + "1~">" + "#".

         IF a-lang = 1 THEN RUN radio_construction("101135,101136,101139,101140,101141,101142",lst-mon,OUTPUT ligne).
         ELSE RUN radio_construction("101135,101136,101139,101140,101141,101142",lst-mon,OUTPUT ligne).

         lst-valeur = lst-valeur + ligne.
         
         flag-aff = TRUE.
         nom_page = SEARCH("abo_new_ligne.htm").
         IF nom_page = ? THEN RETURN.
         INPUT FROM VALUE(nom_page).
         REPEAT:
            IMPORT UNFORMATTED ligne.
            pos = INDEX(ligne,"<!--WSTAG").
            IF TRIM(ligne) BEGINS "<!--" AND pos = 0 THEN NEXT.
            IF pos = 0 THEN {&out} ligne SKIP.
            ELSE DO:
               RUN decode_tag(ligne,"champ",OUTPUT lst-tag).
               DO i = 1 TO NUM-ENTRIES(lst-tag).
                  RUN remplace_tag ("champ",6,ENTRY(i,lst-tag),lst-valeur,INPUT-OUTPUT ligne).
               END.
              {&out} ligne SKIP.
            END.
         END.
     END.
  END.
  
END PROCEDURE.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME


&Scoped-define SELF-NAME ab_unmap.navigation
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL ab_unmap.navigation w-html WEB.output
PROCEDURE ab_unmap.navigation.output .
/*------------------------------------------------------------------------------
  Purpose:     Output the value of the field to the WEB stream
               in place of the HTML field definition.
  Parameters:  p-field-defn
  Notes:       
------------------------------------------------------------------------------*/
  DEFINE INPUT PARAMETER p-field-defn AS CHARACTER NO-UNDO.
  
  IF flag-aff THEN RUN navigue.p (101167,a-lang).
  
END PROCEDURE.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME


&Scoped-define SELF-NAME ab_unmap.prog_suivant
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL ab_unmap.prog_suivant w-html WEB.output
PROCEDURE ab_unmap.prog_suivant.output .
/*------------------------------------------------------------------------------
  Purpose:     Output the value of the field to the WEB stream
               in place of the HTML field definition.
  Parameters:  p-field-defn
  Notes:       
------------------------------------------------------------------------------*/
  DEFINE INPUT PARAMETER p-field-defn AS CHARACTER NO-UNDO.
  
  DO WITH FRAME {&FRAME-NAME}:
     IF REQUEST_METHOD = "POST":U AND buf-psuivant <> "" THEN DO:
        {&out} "" SKIP
               "".
        {&out} buf-psuivant.
        {&out} "" SKIP.
     END.
  END.
  
END PROCEDURE.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME


&Scoped-define SELF-NAME ab_unmap.texte1
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL ab_unmap.texte1 w-html WEB.output
PROCEDURE ab_unmap.texte1.output .
/*------------------------------------------------------------------------------
  Purpose:     Output the value of the field to the WEB stream
               in place of the HTML field definition.
  Parameters:  p-field-defn
  Notes:       
------------------------------------------------------------------------------*/
  DEFINE INPUT PARAMETER p-field-defn AS CHARACTER NO-UNDO.
  
  DO WITH FRAME {&FRAME-NAME}:
     RUN affiche_texte(101146,"abo_select_texte1.htm").
  END.
  
END PROCEDURE.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME


&Scoped-define SELF-NAME ab_unmap.texte2
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL ab_unmap.texte2 w-html WEB.output
PROCEDURE ab_unmap.texte2.output .
/*------------------------------------------------------------------------------
  Purpose:     Output the value of the field to the WEB stream
               in place of the HTML field definition.
  Parameters:  p-field-defn
  Notes:       
------------------------------------------------------------------------------*/
  DEFINE INPUT PARAMETER p-field-defn AS CHARACTER NO-UNDO.
  
  DO WITH FRAME {&FRAME-NAME}:
     RUN affiche_texte(101147,"abo_select_texte2.htm").
  END.
  
END PROCEDURE.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME


&Scoped-define SELF-NAME ab_unmap.texte3
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL ab_unmap.texte3 w-html WEB.output
PROCEDURE ab_unmap.texte3.output .
/*------------------------------------------------------------------------------
  Purpose:     Output the value of the field to the WEB stream
               in place of the HTML field definition.
  Parameters:  p-field-defn
  Notes:       
------------------------------------------------------------------------------*/
  DEFINE INPUT PARAMETER p-field-defn AS CHARACTER NO-UNDO.
  
  DO WITH FRAME {&FRAME-NAME}:
      RUN affiche_texte(101148,"abo_select_texte3.htm").
  END.
  
END PROCEDURE.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME


&UNDEFINE SELF-NAME

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _MAIN-BLOCK w-html 


/* ************************  Main Code Block  ************************* */

/* Standard Main Block that runs adm-create-objects, initializeObject 
 * and process-web-request.
 * The bulk of the web processing is in the Procedure process-web-request
 * elsewhere in this Web object.
 */
{src/web2/template/hmapmain.i}

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME


/* **********************  Internal Procedures  *********************** */

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE adm-create-objects w-html  _ADM-CREATE-OBJECTS
PROCEDURE adm-create-objects :
/*------------------------------------------------------------------------------
  Purpose:     Create handles for all SmartObjects used in this procedure.
               After SmartObjects are initialized, then SmartLinks are added.
  Parameters:  <none>
------------------------------------------------------------------------------*/

END PROCEDURE.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE affiche_texte w-html 
PROCEDURE affiche_texte :
/*------------------------------------------------------------------------------
  Purpose:     
  Parameters:  <none>
  Notes:       
------------------------------------------------------------------------------*/

  DEF INPUT PARAMETER par-noerr      AS     INTEGER.
  DEF INPUT PARAMETER par-nompage    AS     CHARACTER.


  DEF VAR nom_page        AS CHARACTER      NO-UNDO.
  DEF VAR ligne           AS CHARACTER      NO-UNDO.
  DEF VAR lst-tag         AS CHARACTER      NO-UNDO.
  DEF VAR pos             AS INTEGER        NO-UNDO.

  DO WITH FRAME {&FRAME-NAME}:
     FIND erreur WHERE erreur.noerr = par-noerr
                    AND erreur.lang  = a-lang NO-LOCK NO-ERROR.

     nom_page = SEARCH(par-nompage).
     IF nom_page = ? THEN RETURN.
     INPUT FROM VALUE(nom_page).
     REPEAT:
        IMPORT UNFORMATTED ligne.
        pos = INDEX(ligne,"<!--WSTAG").
        IF TRIM(ligne) BEGINS "<!--" AND pos = 0 THEN NEXT.
        IF pos = 0 THEN {&out} ligne SKIP.
        ELSE DO:
           RUN decode_tag(ligne,"texte",OUTPUT lst-tag).
           DO i = 1 TO NUM-ENTRIES(lst-tag).
              RUN remplace_tag ("texte",1,ENTRY(i,lst-tag),erreur.libel,INPUT-OUTPUT ligne).
           END.
           {&out} ligne SKIP.
        END.
     END.

  END.
END PROCEDURE.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE aff_label w-html 
PROCEDURE aff_label :
/*------------------------------------------------------------------------------
  Purpose:     
  Parameters:  <none>
  Notes:       
------------------------------------------------------------------------------*/

  DEF INPUT PARAMETER num  AS INTEGER NO-UNDO.
  FIND erreur WHERE erreur.noerr = num
                AND erreur.lang  = a-lang NO-LOCK NO-ERROR.
  IF AVAILABLE erreur AND erreur.libel <> "" THEN {&out} TRIM(erreur.libel).
END PROCEDURE.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE charge_abonnement w-html 
PROCEDURE charge_abonnement :
/*------------------------------------------------------------------------------
  Purpose:     
  Parameters:  <none>
  Notes:       
------------------------------------------------------------------------------*/
DEF BUFFER WK-hist FOR hist.

FOR EACH hist WHERE hist.prov  = "ADRA"
                AND hist.nosoc = 1
                AND hist.clef  = STRING(buf-nocli,"999999") + STRING(buf-csmt,"9")
                NO-LOCK BREAK BY hist.nohist
                              BY hist.nolig:
    IF FIRST-OF(hist.nohist) AND hist.fmaj THEN DO:

       IF hist.nohist < 100 AND 
         (hist.code4 <> "" OR hist.code3 = "3") THEN NEXT. /* seulement abo en cours */

       FIND FIRST WK-hist WHERE WK-hist.prov   = "ADRA"
                            AND WK-hist.nosoc  = 0
                            AND WK-hist.nohist = hist.nohist
                            AND WK-hist.clef   = "0001" NO-LOCK NO-ERROR.
       CREATE TT-abo.
       ASSIGN TT-abo.nohist = hist.nohist
              TT-abo.libel  = IF AVAILABLE WK-hist THEN  WK-hist.libel ELSE ""
              TT-abo.nb     = hist.mont    
              TT-abo.recu   = IF hist.unit <> 0 THEN REPLACE(STRING(hist.unit,"9999.99"),".","/")
                              ELSE "&nbsp;"
              TT-abo.ech    = STRING(hist.dat,"99/99/9999")
              TT-abo.idr    = RECID(hist)
              TT-abo.id     = "R" + STRING(RECID(hist)).
    END.
END.

END PROCEDURE.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE decode_tag w-html 
PROCEDURE decode_tag :
/*------------------------------------------------------------------------------
  Purpose:     
  Parameters:  <none>
  Notes:       
------------------------------------------------------------------------------*/

DEF INPUT  PARAMETER ligne    AS CHARACTER           NO-UNDO.
DEF INPUT  PARAMETER ancre    AS CHARACTER           NO-UNDO.
DEF OUTPUT PARAMETER lst-tag  AS CHARACTER           NO-UNDO.

DEF VAR i              AS INTEGER           NO-UNDO.
DEF VAR j              AS INTEGER           NO-UNDO.
DEF VAR pos            AS INTEGER           NO-UNDO.
DEF VAR tag            AS CHARACTER         NO-UNDO.


  REPEAT:
     i = INDEX(ligne,"<!--").
     j = IF INDEX(ligne,"-->") <> 0 THEN INDEX(ligne,"-->") + 2 ELSE LENGTH(ligne).
     IF i = 0 THEN LEAVE.
     tag = SUBSTRING(ligne,i,j - i + 1).
     pos = INDEX(tag,"<!--WSTAG").
     IF pos <> 0 THEN DO:
        pos = INDEX(tag,ancre).
        IF pos <> 0 AND LOOKUP(tag,lst-tag) = 0 THEN lst-tag = lst-tag + "," + tag.
     END.
     ligne = SUBSTRING(ligne,j + 1).
  END.
  lst-tag = SUBSTRING(lst-tag,2).
END PROCEDURE.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE edit_entete2 w-html 
PROCEDURE edit_entete2 :
/*------------------------------------------------------------------------------
  Purpose:     
  Parameters:  <none>
  Notes:       
------------------------------------------------------------------------------*/
  DEF OUTPUT PARAMETER p-texte       AS       CHARACTER    NO-UNDO.


  DEF VAR nom_page        AS CHARACTER      NO-UNDO.
  DEF VAR ligne           AS CHARACTER      NO-UNDO.
  DEF VAR tmp-txt         AS CHARACTER      NO-UNDO.
  DEF VAR lst-tag         AS CHARACTER      NO-UNDO.
  DEF VAR pos             AS INTEGER        NO-UNDO.
  DEF VAR k               AS INTEGER        NO-UNDO.

  DO WITH FRAME {&FRAME-NAME}:
     
     FIND erreur WHERE erreur.noerr = 101155
                    AND erreur.lang  = a-lang NO-LOCK NO-ERROR.
     REPEAT i = 1 TO 3:
        tmp-txt = tmp-txt + ENTRY(i,erreur.libel,"#") + "#".
     END.
      
     j = NUM-ENTRIES(lst-mon).

     REPEAT k = 1 TO NUM-ENTRIES(lst-mon):
         tmp-txt = tmp-txt + ENTRY(k + 3,erreur.libel,"#") + "#".
         IF j = 1 THEN tmp-txt = REPLACE(tmp-txt,"&1",lst-mon).
         ELSE tmp-txt = REPLACE(tmp-txt,"&" + STRING(k),ENTRY(k,lst-mon) + "<input type=~"radio~" name=~"monnaie~" id=~"m" 
                                            + ENTRY(k,lst-mon) + "~" value=~"" + ENTRY(k,lst-mon) + "~">").
     END.

     nom_page = SEARCH("abo_new_entete2.htm").
     IF nom_page = ? THEN RETURN.
     INPUT FROM VALUE(nom_page).
     REPEAT:
        IMPORT UNFORMATTED ligne.
        pos = INDEX(ligne,"<!--WSTAG").
        IF TRIM(ligne) BEGINS "<!--" AND pos = 0 THEN NEXT.
        IF pos = 0 THEN {&out} ligne SKIP.
        ELSE DO:
           RUN decode_tag(ligne,"label",OUTPUT lst-tag).
           DO i = 1 TO NUM-ENTRIES(lst-tag).
              RUN remplace_tag ("label",6,ENTRY(i,lst-tag),tmp-txt,INPUT-OUTPUT ligne).
           END.
           p-texte = p-texte + ligne.
        END.
     END.
  END.
END PROCEDURE.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE htmOffsets w-html  _WEB-HTM-OFFSETS
PROCEDURE htmOffsets :
/*------------------------------------------------------------------------------
  Purpose:     Runs procedure to associate each HTML field with its
               corresponding widget name and handle.
  Parameters:  
  Notes:       
------------------------------------------------------------------------------*/
  RUN readOffsets ("{&WEB-FILE}":U).
  RUN htmAssociate
    ("abocad":U,"ab_unmap.abocad":U,ab_unmap.abocad:HANDLE IN FRAME {&FRAME-NAME}).
  RUN htmAssociate
    ("cadeauset":U,"ab_unmap.cadeauset":U,ab_unmap.cadeauset:HANDLE IN FRAME {&FRAME-NAME}).
  RUN htmAssociate
    ("entete":U,"ab_unmap.entete":U,ab_unmap.entete:HANDLE IN FRAME {&FRAME-NAME}).
  RUN htmAssociate
    ("erreur":U,"ab_unmap.erreur":U,ab_unmap.erreur:HANDLE IN FRAME {&FRAME-NAME}).
  RUN htmAssociate
    ("FRowid":U,"ab_unmap.FRowid":U,ab_unmap.FRowid:HANDLE IN FRAME {&FRAME-NAME}).
  RUN htmAssociate
    ("ident":U,"ab_unmap.ident":U,ab_unmap.ident:HANDLE IN FRAME {&FRAME-NAME}).
  RUN htmAssociate
    ("labcadeau":U,"ab_unmap.labcadeau":U,ab_unmap.labcadeau:HANDLE IN FRAME {&FRAME-NAME}).
  RUN htmAssociate
    ("lang":U,"ab_unmap.alang":U,ab_unmap.alang:HANDLE IN FRAME {&FRAME-NAME}).
  RUN htmAssociate
    ("ligne":U,"ab_unmap.ligne":U,ab_unmap.ligne:HANDLE IN FRAME {&FRAME-NAME}).
  RUN htmAssociate
    ("LRowid":U,"ab_unmap.LRowid":U,ab_unmap.LRowid:HANDLE IN FRAME {&FRAME-NAME}).
  RUN htmAssociate
    ("navigation":U,"ab_unmap.navigation":U,ab_unmap.navigation:HANDLE IN FRAME {&FRAME-NAME}).
  RUN htmAssociate
    ("nbart":U,"ab_unmap.nbart":U,ab_unmap.nbart:HANDLE IN FRAME {&FRAME-NAME}).
  RUN htmAssociate
    ("prog_suivant":U,"ab_unmap.prog_suivant":U,ab_unmap.prog_suivant:HANDLE IN FRAME {&FRAME-NAME}).
  RUN htmAssociate
    ("texte1":U,"ab_unmap.texte1":U,ab_unmap.texte1:HANDLE IN FRAME {&FRAME-NAME}).
  RUN htmAssociate
    ("texte2":U,"ab_unmap.texte2":U,ab_unmap.texte2:HANDLE IN FRAME {&FRAME-NAME}).
  RUN htmAssociate
    ("texte3":U,"ab_unmap.texte3":U,ab_unmap.texte3:HANDLE IN FRAME {&FRAME-NAME}).
  RUN htmAssociate
    ("TypeInt":U,"ab_unmap.TypeInt":U,ab_unmap.TypeInt:HANDLE IN FRAME {&FRAME-NAME}).
END PROCEDURE.


/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE initialisation w-html 
PROCEDURE initialisation :
/*------------------------------------------------------------------------------
  Purpose:     
  Parameters:  <none>
  Notes:       
------------------------------------------------------------------------------*/
   DEF VAR flag-marq        AS      LOGICAL     NO-UNDO.


   a-lang = INTEGER(get-field("lang")).
   
   IF a-lang = 0 THEN a-lang = 2.

   DO WITH FRAME {&FRAME-NAME}:
      

   END.

/*    RUN get-couleur.p ("01",ENTRY(1,get-cookie("CliId")),OUTPUT wcoul-coli).  */
/*    RUN get-couleur.p ("02",ENTRY(1,get-cookie("CliId")),OUTPUT wcoul-colp).  */

END PROCEDURE.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE outputHeader w-html 
PROCEDURE outputHeader :
/*------------------------------------------------------------------------
  Purpose:     Output the MIME header, and any "cookie" information needed 
               by this procedure.  
  Parameters:  <none>
  Notes:       In the event that this Web object is state-aware, this is 
               a good place to set the WebState and WebTimeout attributes.
------------------------------------------------------------------------*/
  /* To make this a state-aware Web object, pass in the timeout period
   * (in minutes) before running outputContentType.  If you supply a 
   * timeout period greater than 0, the Web object becomes state-aware 
   * and the following happens:
   *
   *   - 4GL variables webState and webTimeout are set
   *   - a cookie is created for the broker to id the client on the return trip
   *   - a cookie is created to id the correct procedure on the return trip
   *
   * If you supply a timeout period less than 1, the following happens:
   *
   *   - 4GL variables webState and webTimeout are set to an empty string
   *   - a cookie is killed for the broker to id the client on the return trip
   *   - a cookie is killed to id the correct procedure on the return trip
   *
   * For example, set the timeout period to 5 minutes.
   *
   *   setWebState (5.0).
   */
    
  /* Output additional cookie information here before running outputContentType.
   *   For more information about the Netscape Cookie Specification, see
   *   http://home.netscape.com/newsref/std/cookie_spec.html  
   *   
   *   Name         - name of the cookie
   *   Value        - value of the cookie
   *   Expires date - Date to expire (optional). See TODAY function.
   *   Expires time - Time to expire (optional). See TIME function.
   *   Path         - Override default URL path (optional)
   *   Domain       - Override default domain (optional)
   *   Secure       - "secure" or unknown (optional)
   * 
   *   The following example sets custNum=23 and expires tomorrow at (about)
   *   the same time but only for secure (https) connections.
   *      
   *   RUN SetCookie IN web-utilities-hdl 
   *     ("custNum":U, "23":U, TODAY + 1, TIME, ?, ?, "secure":U).
   */ 
  output-content-type ("text/html":U).
  
END PROCEDURE.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE process-web-request w-html 
PROCEDURE process-web-request :
/*------------------------------------------------------------------------
  Purpose:     Process the web request.
  Notes:       
------------------------------------------------------------------------*/
    
  /* STEP 0 -
   * Output the MIME header and set up the object as state-less or state-aware. 
   * This is required if any HTML is to be returned to the browser. 
   *
   * NOTE: Move 'RUN outputHeader.' to the GET section below if you are going
   * to simulate another Web request by running a Web Object from this
   * procedure.  Running outputHeader precludes setting any additional cookie
   * information.
   */ 
   
  RUN initialisation.
       
  IF get-cookie("SessionId") <> "" THEN
     ASSIGN buf-nocli = INTEGER(ENTRY(1,get-cookie("SessionId")))
            buf-csmt  = 0.

  IF get-cookie("abonnement") <> "" THEN abo-cour = ENTRY(1,get-cookie("abonnement"),"#").

  lst-mon = "CHF,EUR,USD,CAN".
  IF buf-nocli <> 0 THEN DO:
     FIND adrd WHERE adrd.nosoc = buf-nosoc
                 AND adrd.noadr = buf-nocli
                 AND adrd.csmt  = 0 NO-LOCK NO-ERROR.
     IF AVAILABLE adrd THEN lst-mon = adrd.codmon.
  END.

  FIND hist WHERE hist.prov   = "ADRA"
              AND hist.nosoc  = 0
              AND hist.clef   = "0000"
              AND hist.nohist = 11 NO-LOCK NO-ERROR.
  CREATE TT-abo.
  ASSIGN TT-abo.nohist = hist.nohist
         TT-abo.libel  = IF AVAILABLE hist THEN  hist.libel ELSE ""
         TT-abo.nb     = 1    
         TT-abo.recu   = "&nbsp;"
         TT-abo.ech    = ?
         TT-abo.idr    = ?
         TT-abo.id     = "".

  /* Describe whether to receive FORM input for all the fields.  For example,
   * check particular input fields (using GetField in web-utilities-hdl). 
   * Here we look at REQUEST_METHOD. 
   */
  IF REQUEST_METHOD = "POST":U THEN DO:
    /* STEP 1 -
     * Copy HTML input field values to the Progress form buffer. */
    RUN inputFields.
        /* STEP 2 -
     * Open the database or SDO query and and fetch the first record. */ 
    RUN findRecords.
    
    /* STEP 3 -    
     * AssignFields will save the data in the frame.
     * (it automatically upgrades the lock to exclusive while doing the update)
     * 
     *  If a new record needs to be created set AddMode to true before 
        running assignFields.  
     *     setAddMode(TRUE).   
     * RUN assignFields. */
    
    /* STEP 4 -
     * Decide what HTML to return to the user. Choose STEP 4.1 to simulate
     * another Web request -OR- STEP 4.2 to return the original form (the
     * default action).
     *
     * STEP 4.1 -
     * To simulate another Web request, change the REQUEST_METHOD to GET
     * and RUN the Web object here.  For example,
     *
     *  ASSIGN REQUEST_METHOD = "GET":U.
     *  RUN run-web-object IN web-utilities-hdl ("myobject.w":U).
     */
     
    IF get-cookie("Livraison") <> "" THEN ab_unmap.abocad = TRUE.

    action = get-field("cadeauset").
    IF action <> "" THEN DO:
        IF get-cookie("Livraison") <> "" AND get-field("abocad") = "" THEN DO:
           buf-nocad = INTEGER(get-cookie("Livraison")).
           RUN SetCookie IN web-utilities-hdl ("Livraison","",?,?,?,?,?).
           FIND adra WHERE adra.nosoc = buf-nosoc
                       AND adra.noadr = buf-nocad
                       AND adra.csmt  = 0 NO-ERROR.
           IF AVAILABLE adra THEN DELETE adra.
           FIND adrd WHERE adrd.nosoc = adra.nosoc
                       AND adrd.noadr = adra.noadr
                       AND adrd.csmt  = adra.csmt NO-ERROR.
           IF AVAILABLE adrd THEN DELETE adrd.
           flag-delete = TRUE.
           ab_unmap.abocad = FALSE.
        END.
        ELSE DO:
           IF a-lang = 1 THEN  buf-psuivant = "abo_gift|de|573".
           ELSE  buf-psuivant = "abo_gift|fr|131".
        END.

      /* ?par-prog=abo_new.w */

    END.
    ELSE DO:
       action   = get-field("navigue").

       FIND erreur WHERE erreur.noerr = 101167
                     AND erreur.lang  = a-lang NO-LOCK NO-ERROR.
       DO i = 1 to NUM-ENTRIES(erreur.libel):
          lab-bouton[i] = ENTRY(i,erreur.libel).
       END.

       IF action <> lab-bouton[1] AND
          action <> lab-bouton[2] AND
          action <> lab-bouton[3] AND
          action <> lab-bouton[4] AND
          action <> lab-bouton[5] THEN action = lab-bouton[1].

       IF action = lab-bouton[1] OR
          action = lab-bouton[2] THEN DO:
          flag-select = TRUE.
          FOR EACH TT-abo:
              IF TRIM(get-field("dure" + TT-abo.id)) = "" THEN flag-select = FALSE.
              ELSE DO:
                 RUN SetCookie IN web-utilities-hdl ("abonnement",get-field("dure" + TT-abo.id) + "#" + lst-mon + "#" + get-field("nb"),?,?,?,?,?).
              END.
          END.
       END.
       IF flag-select THEN DO:
          IF action = lab-bouton[1] THEN DO:
             IF a-lang = 1 THEN  buf-psuivant = "renew_abo_pay|de|572".
             ELSE buf-psuivant = "renew_abo_pay|fr|134".
          END.
       END.
    END.
    
    /* STEP 4.2 -
     * To return the form again, set data values, display them, and output 
     * them to the WEB stream.  
     *
     * STEP 4.2a -
     * Set any values that need to be set, then display them. */
    RUN displayFields.
   
    /* STEP 4.2b -
     * Enable objects that should be enabled. */
    RUN enableFields.
    
    RUN outputHeader.

    /* STEP 4.2c -
     * OUTPUT the Progress form buffer to the WEB stream. */
    RUN outputFields.
    
  END. /* Form has been submitted. */
 
  /* REQUEST-METHOD = GET */ 
  ELSE DO:
    /* This is the first time that the form has been called. Just return the
     * form.  Move 'RUN outputHeader.' here if you are going to simulate
     * another Web request. */ 

    RUN outputHeader.

    /* STEP 1 -
     * Open the database or SDO query and and fetch the first record. */ 
    RUN findRecords.
    
    IF get-cookie("Livraison") <> "" THEN ab_unmap.abocad = TRUE.

    /* Return the form again. Set data values, display them, and output them
     * to the WEB stream.  
     *
     * STEP 2a -
     * Set any values that need to be set, then display them. */
    RUN displayFields.

    /* STEP 2b -
     * Enable objects that should be enabled. */
    RUN enableFields.

    /* STEP 2c -
     * OUTPUT the Progress from buffer to the WEB stream. */
    RUN outputFields.
  END. 
  
  /* Show error messages. */

  IF AnyMessage() THEN 
  DO:
     /* ShowDataMessage may return a Progress column name. This means you
      * can use the function as a parameter to HTMLSetFocus instead of 
      * calling it directly.  The first parameter is the form name.   
      *
      * HTMLSetFocus("document.DetailForm",ShowDataMessages()). */
     ShowDataMessages().
  END.
 
END PROCEDURE.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE radio_construction w-html 
PROCEDURE radio_construction :
/*------------------------------------------------------------------------------
  Purpose:     
  Parameters:  <none>
  Notes:       
------------------------------------------------------------------------------*/
DEF INPUT  PARAMETER p-noerr      AS     CHARACTER      NO-UNDO.
DEF INPUT  PARAMETER p-mon        AS     CHARACTER      NO-UNDO.
DEF OUTPUT PARAMETER p-texte      AS     CHARACTER      NO-UNDO.

DEF VAR i           AS     INTEGER        NO-UNDO.
DEF VAR j           AS     INTEGER        NO-UNDO.
DEF VAR k           AS     INTEGER        NO-UNDO.
DEF VAR tmp-libel   AS     CHARACTER      NO-UNDO.
DEF VAR tmp-prix    AS     CHARACTER      NO-UNDO.

FIND erreur WHERE erreur.noerr = 101155
              AND erreur.lang  = a-lang NO-LOCK NO-ERROR.

p-texte = "<table border=~"0~" width=~"100%~">"
        + "<tr class=~"head~">"
        + "<th width=~"*~">&nbsp;</th>"
        + "<th width=~"57%~">" + ENTRY(3,erreur.libel,"#") + "</th>"
        + "<th width=~"13%~">" + lst-mon + "</th>"
        + "</tr>".

REPEAT i = 1 TO NUM-ENTRIES(p-noerr):
   j = INTEGER(ENTRY(i,p-noerr)).
   FIND erreur WHERE erreur.noerr = j
                 AND erreur.lang  = a-lang NO-LOCK NO-ERROR.
   IF NOT AVAILABLE erreur OR TRIM(erreur.libel) = "" THEN NEXT.
   tmp-libel = IF AVAILABLE erreur THEN TRIM(erreur.libel) ELSE "i,".

   p-texte = p-texte + "<tr><td align=~"center~" valign=~"top~" width=~"*~"><input type=~"radio~" name=~"dure" + TT-abo.id 
                     + "~" id =~""+ TT-abo.id + STRING(i) + "~" value=~"" 
                     + ENTRY(1,tmp-libel) + "~""
                     + (IF abo-cour = ENTRY(1,tmp-libel) THEN " checked" ELSE "") 
                     + "></td><td width=~57%~"><label for=~"" + TT-abo.id + STRING(i) 
                     + "~">"
                     + ENTRY(2,tmp-libel) + "</label></td>".

   REPEAT k = 1 TO NUM-ENTRIES(lst-mon):
       FIND apri WHERE apri.nosoc  = 1
                   AND apri.typr   = TRUE
                   AND apri.noadr  = 0
                   AND apri.csmt   = 0
                   AND apri.ref    = "R10" + STRING(TT-abo.nohist,"99")
                   AND apri.datfin = 12/31/2999
                   AND apri.codmon = ENTRY(k,p-mon)
                   AND apri.noprix = INTEGER(ENTRY(1,tmp-libel)) NO-LOCK NO-ERROR.

       tmp-prix = IF AVAILABLE apri THEN TRIM(STRING(apri.prix,">>>9")) ELSE "".

       p-texte = p-texte + "<td align=~"right~" valign=~"top~" width=~"13%~">"
                         + tmp-prix + "&nbsp;</td>".
   END.
END.

p-texte = p-texte + "</tr></table>".

END PROCEDURE.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE remplace_tag w-html 
PROCEDURE remplace_tag :
/*------------------------------------------------------------------------------
  Purpose:     
  Parameters:  <none>
  Notes:       
------------------------------------------------------------------------------*/

DEF INPUT        PARAMETER ancre    AS   CHARACTER        NO-UNDO.       
DEF INPUT        PARAMETER nombre   AS   INTEGER          NO-UNDO.       
DEF INPUT        PARAMETER tag      AS   CHARACTER        NO-UNDO.       
DEF INPUT        PARAMETER texte    AS   CHARACTER        NO-UNDO.       
DEF INPUT-OUTPUT PARAMETER ligne    AS   CHARACTER        NO-UNDO.

DEF VAR i          AS   INTEGER                    NO-UNDO.

DO i = 1 TO nombre:
   IF INDEX(tag,ancre + STRING(i,"99")) <> 0 THEN ligne = REPLACE(ligne,tag,ENTRY(i,texte,"#")).
END.

END PROCEDURE.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME

